home *** CD-ROM | disk | FTP | other *** search
/ Point Programming 1 / PPROG1.ISO / pascal / swag / printing.swg / 0030_Control DOS Print Spooler.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-01-27  |  7.2 KB  |  252 lines
  1. {
  2. Here a nice unit to control the DOS Printer spooler (PRINT.COM/EXE).
  3. It's a extended/modified/debugged version of some program I found
  4. elsewere. By controlling the DEFINE the source changes from PROGRAM
  5. to UNIT. Just load good PRINT, Compile the demo and try to print some.
  6. Watch your paper supply !!
  7.  
  8. {---------------------------------------------------------}
  9. { Original by Brian Ebarb Power Software Company -        }
  10. {             Houston, TX (713)781-9784                   }
  11. {                                                         }
  12. { Modified by G.W. van der Vegt                           }
  13. {---------------------------------------------------------}
  14.  
  15. { DEFINE UNIT}
  16. {$IFDEF  UNIT}
  17.  
  18. UNIT Spooler;
  19.  
  20. INTERFACE
  21.  
  22. {$ELSE}
  23.  
  24. USES
  25.   crt,
  26.   dos;
  27.  
  28. {$ENDIF}
  29.  
  30. CONST
  31.   queue_max         = 10;
  32.   queue_namlen      = 64;
  33.  
  34. TYPE
  35. {----Queue types}
  36.   queue_action      = 1..5;
  37.   queue_printer     = 1..4;
  38.   queue_name        = STRING[queue_namlen-1];
  39.   queue_type        = ARRAY[1..queue_max] OF queue_name;
  40.  
  41. CONST
  42. {----Queue actions}
  43.   queue_submit      = 1;
  44.   queue_kill        = 2;
  45.   queue_purge       = 3;
  46.   queue_hold        = 4;
  47.   queue_continue    = 5;
  48.  
  49. {----Queue results}
  50.   queue_ok          = $00;
  51.   queue_invfie      = $01;
  52.   queue_nofile      = $02;
  53.   queue_nopath      = $03;
  54.   queue_nohandles   = $04;
  55.   queue_noaccess    = $05;
  56.   queue_full        = $08;
  57.   queue_busy        = $09;
  58.   queue_missing     = $0a; {----self defined returncode,
  59.                                 returned IF called AND NOT
  60.                                 installed.}
  61.   queue_longname    = $0c;
  62.   queue_nowprinting = $9e;
  63.  
  64. VAR
  65.   queue             : queue_type;
  66.  
  67. {$IFDEF UNIT}
  68.  
  69. FUNCTION Spool(filestring : queue_name;
  70.                theprinter : queue_printer;
  71.                action     : queue_action) : WORD;
  72.  
  73. {---------------------------------------------------------}
  74.  
  75. IMPLEMENTATION
  76.  
  77. USES
  78.   crt,
  79.   dos;
  80.  
  81. {---------------------------------------------------------}
  82.  
  83. {$ENDIF}
  84.  
  85. FUNCTION Spool(filestring : queue_name;
  86.                theprinter : queue_printer;
  87.                action     : queue_action) : WORD;
  88.  
  89. CONST
  90. {----MPX interrupt const}
  91.   queue_int         = $2f;
  92.   queue_mpx         = $01;
  93.   queue_check       = $00;
  94.   queue_installed   = $ff;
  95.  
  96. TYPE
  97.   fnames  = ARRAY[1..queue_namlen] OF CHAR;
  98.   res     = ARRAY[1..32768 DIV Sizeof(fnames)] OF fnames;
  99.  
  100. VAR
  101.   p       : ^res;
  102.   regs    : registers;
  103.   fname   : fnames;
  104.   thefile : RECORD
  105.               prn  : BYTE;
  106.               loc  : ARRAY[1..2] OF WORD;
  107.             END;
  108.   i,j     : INTEGER;
  109.  
  110. BEGIN
  111.   Fillchar(fname, Sizeof(fname), #0);
  112.   Move(filestring[1],fname[1],Length(filestring));
  113.  
  114.   thefile.prn    := theprinter - 1;
  115.   thefile.loc[2] := Seg(fname);
  116.   thefile.loc[1] := Ofs(fname);
  117.  
  118. {----Check installation}
  119.   regs.ah := queue_mpx;
  120.   regs.al := queue_check;
  121.  
  122.   Intr(queue_int, regs);
  123.   IF (regs.al<>queue_installed)
  124.   {----on return, 10 = "not installed" }
  125.     THEN Spool:=queue_missing
  126.     ELSE
  127.       CASE action OF
  128.                {----Spool a FILE, return error OR
  129.                                   00 IF no error
  130.                                   01 IF added TO queue OR
  131.                                   9e IF printing           }
  132.   queue_submit : BEGIN
  133.                    regs.ah:=queue_mpx;
  134.                    regs.al:=queue_submit;
  135.                    regs.ds:=Seg(thefile);
  136.                    regs.dx:=Ofs(thefile);
  137.  
  138.                    Intr(queue_int, regs);
  139.  
  140.                    IF ((regs.flags AND fcarry) = fcarry)
  141.                      THEN Spool:=regs.ax
  142.                      ELSE Spool:=regs.al;
  143.                  END;
  144.                {----Dequeue a file, Returns Error or ok }
  145.     queue_kill : BEGIN
  146.                    regs.ah:=queue_mpx;
  147.                    regs.al:=queue_kill;
  148.                    regs.ds:=thefile.loc[2];
  149.                    regs.dx:=thefile.loc[1];
  150.  
  151.                    Intr(queue_int, regs);
  152.  
  153.                    IF ((regs.flags AND fcarry) = fcarry)
  154.                      THEN Spool := regs.ax
  155.                      ELSE Spool := queue_ok;
  156.                  END;
  157.  
  158.                {----Deque ALL files, Returns Error or ok }
  159.    queue_purge : BEGIN
  160.                    regs.ah := queue_mpx;
  161.                    regs.al := queue_purge;
  162.  
  163.                    Intr(queue_int, regs);
  164.  
  165.                    IF ((regs.flags AND fcarry) = fcarry)
  166.                      THEN Spool := regs.ax
  167.                      ELSE Spool := queue_ok;
  168.                  END;
  169.  
  170.                {----Hold queue, returns error OR
  171.                                 no. OF errors since last hold (dx) ?
  172.                                 (seems TO be no. OF looks at Printer port) &
  173.                                 queue RECORD WITH first queue_max filenames}
  174.     queue_hold : BEGIN
  175.                    regs.ah:=queue_mpx;
  176.                    regs.al:=queue_hold;
  177.  
  178.                    Intr(queue_int, regs);
  179.  
  180.                    IF ((regs.flags AND fcarry) = fcarry)
  181.                      THEN Spool := regs.ax
  182.                      ELSE
  183.                      {----Fill & return the queue record}
  184.                        BEGIN
  185.                          Spool:=queue_ok; {Regs.dx}
  186.                          p:=Ptr(regs.ds,regs.si);
  187.  
  188.                          FOR i:=1 TO queue_max DO queue[i]:='';
  189.                          i:=1;
  190.                          WHILE (p^[i,1]<>#00) AND (i<=queue_max) DO
  191.                            BEGIN
  192.                              j:=1;
  193.                              WHILE (p^[i,j]<>#00) DO
  194.                                BEGIN
  195.                                  queue[i]:=queue[i]+p^[i,j];
  196.                                  Inc(j);
  197.                                END;
  198.                              Inc(i);
  199.                            END;
  200.                        END;
  201.                  END;
  202.  
  203.             {----Restart queue after function 4, Returns error or ok }
  204. queue_continue : BEGIN
  205.                    regs.ah:=queue_mpx;
  206.                    regs.al:=queue_continue;
  207.  
  208.                    Intr(queue_int, regs);
  209.  
  210.                    IF ((regs.flags AND fcarry) = fcarry)
  211.                      THEN Spool := regs.ax
  212.                      ELSE Spool := queue_ok;
  213.                  END;
  214.       END;
  215.  
  216. END; {of Spool}
  217.  
  218. {$IFNDEF UNIT}
  219.  
  220. {---------------------------------------------------------}
  221. {----MAIN PROGRAM                                         }
  222. {---------------------------------------------------------}
  223.  
  224. VAR
  225.   i : INTEGER;
  226.  
  227. BEGIN
  228.   FOR i:=1 TO queue_max DO queue[i]:='';
  229.  
  230.   REPEAT
  231.     Writeln('Type cmd : 1 = submit, 2 = kill, 3 = purge, 4 = hold, 5 = continue
  232.  
  233.     CASE Readkey OF
  234.       #27 : Halt;
  235.       '1' : Writeln('Function 1, result = ',Spool('\AUTOEXEC.BAT',1,queue_submi
  236.       '2' : Writeln('Function 2, result = ',Spool('\AUTOEXEC.BAT',1,queue_kill
  237.       '3' : Writeln('Function 3, result = ',Spool('',1,queue_purge   ));
  238.       '4' : BEGIN
  239.               Writeln('Function 4, result = ',Spool('',1,queue_hold    ));
  240.               Writeln('Queue : ');
  241.               FOR i:=1 TO queue_max DO
  242.                 IF (queue[i]<>'')
  243.                   THEN Writeln(i:2,' ',queue[i]);
  244.             END;
  245.       '5' : Writeln('Function 5, result = ',Spool('',1,queue_continue));
  246.     END;
  247.   UNTIL true=false;
  248.  
  249. {$ENDIF}
  250.  
  251. END.
  252.